COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	IFCR NOT DECLARATION($$PRGID) THENC
C00005 00003	! saves on a file any tty input. The file can be managed only by AL_CLOSE
C00008 00004	! input/output:      altf,altrans,alframe,aldec,al_subtree,alid
C00012 00005	! i/o: readexec,readcode,writecode,alfile,close,al_close
C00017 00006	!	dat_str
C00019 ENDMK
C⊗;
IFCR NOT DECLARATION($$PRGID) THENC
ENTRY;
BEGIN "INPOUT"		ENDC

DEFINE $INPOUT=TRUE;

REQUIRE "HEADER.SAI" SOURCE_FILE;

STRING  ARRAY $NAMEFL[1:10] ;  			! symbol table of files used;
INTEGER ARRAY $CHNFL[1:10,0:1];			! open/closed and ch #;
INTEGER $ALCH;					! $ALCH=channel used for output;
INTEGER $INPCH;					! channel # for input;
INTEGER ALEOF;
INTEGER TTYEOF;

INTEGER PROCEDURE UGETF(INTEGER CHAN);
BEGIN
	define UGETF = '073000;
	INTEGER I,CHN; LABEL DOUGTF;
	CHN←CHAN;
	quick_code;
		move	'13,CHN;
		lsh	'13,5;
		addi	'13,UGETF;
		hrlm	'13,DOUGTF;	! PREPARE UGETF;
	DOUGTF:
		I			;
	end;
	RETURN(I);
END;


INTEGER PROCEDURE UGET(INTEGER CHAN);
BEGIN
	define MTAPE = '072000;
	LABEL ADR,ADR1,DOMTPE; INTEGER CHN;
	INTEGER GMOD; GMOD←CVSIX("GODMOD");
	CHN←CHAN;
	quick_code;
		move	'13,GMOD;
		movem	'13,ADR;
		setzm	'13,adr1;
		move	'13,CHN;
		lsh	'13,5;
		addi	'13,MTAPE;
		hrlm	'13,DOMTPE;
		jrst	DOMTPE	;
	ADR:
		0	;	! '475744555744; ! SIXBIT /GODMOD/;
	ADR1:	0	;
	DOMTPE:
		ADR		;
		move	'13,ADR1;
		movem	'13,CHN;
	end;
	RETURN(CHN);
END;
	
INTERNAL PROCEDURE UDATEFILE(INTEGER CHAN);
BEGIN	INTEGER FLAG; INTEGER I; STRING S;
	I←UGET(CHAN);	CLOSE(CHAN); ! PRINT("CHAN = ",CHAN, $NAMEFL[CHAN]);
	IF CHAN=$TTYCH THEN S←$TTYFL ELSE S←$ALFL;
	LOOKUP(CHAN,S,FLAG);
	ENTER(CHAN,S,FLAG);
	USETI(CHAN,I);	S←NULL;
	IF CHAN≠$TTYCH THEN DO S←S&INPUT(CHAN,0) UNTIL ALEOF
		ELSE DO S←S&INPUT(CHAN,0) UNTIL TTYEOF;
	USETO(CHAN,I);	OUT(CHAN,S);
END;
! saves on a file any tty input. The file can be managed only by AL_CLOSE;
	! The AL_CLOSE instruction without parameters closes all open files and
	  asks for a new tty save file. Upon exit the file is automatically closed;
INTERNAL PROCEDURE TTYSAVE;
	BEGIN STRING ANSWER;
	$TTYFL←NULL;
	OUTSTR("file for TTY output=");ESC_P;
	CLRBUF; ASKUSER;
	IF $CLNE
	   THEN BEGIN
		ANSWER←NAMEFILE;
		OPEN($TTYCH←GETCHAN,"DSK",0,1,2,1000,0,TTYEOF);
		LOOKUP($TTYCH,ANSWER,TTYEOF);
		TTYEOF←-1;
		ENTER($TTYCH,ANSWER,TTYEOF);
		WHILE TTYEOF
		     DO	BEGIN
			PRINT("enter failed");
			ANSWER←FRCVER(ANSWER);
			LOOKUP($TTYCH,ANSWER,TTYEOF);
			ENTER($TTYCH,ANSWER,TTYEOF);
			END;
		IF ¬ TTYEOF THEN BEGIN UGETF($TTYCH); OUT($TTYCH,FF); END;
		OUT($TTYCH,"{ FILE BEING WRITTEN BY POINTY  "&DAT_STR& " }"&CRLF);
		$OUT←TRUE;
		$TTYFL←ANSWER;
		$OULST←NULL;
		END
	   ELSE $OUT←FALSE;
	END;

	! returns a string with the names of files used for output and their 
	  state (open/closed);
INTERNAL STRING PROCEDURE FILE_STRING;
	BEGIN
	INTEGER I;STRING TS;TS←NULL;
	FOR I←1 STEP 1 UNTIL $TOTFL 
	     DO	BEGIN
		IF EQU($NAMEFL[I],$ALFL) 
		   THEN TS←TS&"*"
		   ELSE TS←TS&" ";
		TS←TS&"OC"[1+$CHNFL[I,0] FOR 1]&":"&$NAMEFL[I]&CRLF;
		END;
	RETURN(TS);
	END;
! input/output:      altf,altrans,alframe,aldec,al_subtree,alid;

	! types on the file (open on $ALCH) the frame declaration and assignment
	  of affixment for the frame pointed by nd. If the frame is affixed 
	  independently an assignment instruction is generated, otherwhise an
	  affix instruction, with the correct type of affixment is produced;

PROCEDURE ALDEC(RPTR(FRAME) ND);       
	BEGIN
	STRING NAME,DS,FS;
 	NAME←FRAME:PNAME[ND];				! frame pname;
	DS←"FRAME "&NAME&";"&CRLF;			! declaration;
 	IF FRAME:HOWLINKED[ND]=#INDLK
	   THEN FS←NAME&" ← "&CVX(ND,#FR,FILE_D)&";"&DLF
	   ELSE BEGIN
        	FS←"AFFIX "&NAME&" TO "&FRAME:PNAME[FRAME:DAD[ND]]&" AT"
			&CRLF&$BLANK[1 TO 6]&"TRANS"&CVX(ND,#FR,FILE_D)[6 TO ∞];
		IF FRAME:HOWLINKED[ND]=#NRGLK
		   THEN FS←FS&" NONRIGIDLY;"&DLF
		   ELSE FS←FS&" RIGIDLY;"&DLF;
		END;
	CPRINT($ALCH,DS,FS);
	END;

	! finds the different frames looking at the frame tree;


PROCEDURE MC_OUT(RPTR(SYMBOL) EEE);
	BEGIN 
	STRING MS;
	MS←"DEFINE "&MACRO:HEAD[SYMBOL:OBJECT[EEE]]&" = "&CVSYM(EEE)&";";
	CPRINT($ALCH,MS);
	END;

RECURSIVE PROCEDURE FR_OUT(RPTR(FRAME) ND);
	BEGIN
	RPTR(FRAME) SN; STRING S;
	IF NOT(ND=F_WRLD OR EQU(S←FRAME:PNAME[ND],"BPARK")
		OR EQU(S,"YPARK") OR EQU(S,"BARM")OR EQU(S,"YARM")
		OR EQU(S,"BGRASP"))
		THEN ALDEC(ND);
	SN←FRAME:SON[ND];
	WHILE SN≠NULL_RECORD 
	     DO	BEGIN
		FR_OUT(SN);       
	 	SN←FRAME:EBRO[SN];
		END;
	END;

	! types on the file (open on $ALCH) the declarations and
	  assignments;

PRESET_WITH "SCALAR ","DISTANCE VECTOR ","ROT ","TRANS ","FRAME ";
STRING ARRAY DTYPES[#SC:#FR];

STRING PROCEDURE EL_OUT(RPTR(SYMBOL)ADDR);
	BEGIN
	STRING DS,VS;
	DS←DTYPES[SYMBOL:TYPE[ADDR]]&" "&SYMBOL:PNAME[ADDR]&";"&CRLF;
	VS←SYMBOL:PNAME[ADDR]&" ← "& CVSYM(ADDR,FILE_D)&";"&DLF;
	RETURN(DS&VS);
	END;

PROCEDURE ST_OUT(INTEGER TYPE);
	BEGIN "U" INTEGER I;
	CASE TYPE OF
	    BEGIN "CASE"
		  [#SC] [#VT][#RT][#TR]
			FOR I←OFFSET[RES_OFFSET,TYPE]+1 STEP 1 UNTIL $ENTRY[TYPE] DO
			      CPRINT($ALCH,EL_OUT($YMTAB[TYPE,I]));
		  [#FR] FR_OUT(SYMBOL:OBJECT[WORLD]);
		  [#MC] FOR I←OFFSET[RES_OFFSET,TYPE]+1 STEP 1 UNTIL $ENTRY[TYPE] DO
				MC_OUT($YMTAB[TYPE,I])
		END "CASE";
	END "U";
! i/o: readexec,readcode,writecode,alfile,close,al_close;

	! if the file has been previously used returns its number in table,
	  otherwise returns 0;

INTERNAL INTEGER PROCEDURE ISFILE(STRING FILE);
	BEGIN
	INTEGER I;
	FOR I←1 STEP 1 UNTIL $TOTFL DO
	    IF EQU($NAMEFL[I],FILE) THEN RETURN (I);
	RETURN(0);
	END;

SIMPLE  PROCEDURE OPENFL(REFERENCE STRING FILE;INTEGER IND(0));
	BEGIN 
	INTEGER $NOEXIST;
 	OPEN($ALCH←GETCHAN,"DSK",0,1,2,1000,0,ALEOF);
	ALEOF←-1;
	LOOKUP($ALCH,FILE,$NOEXIST);
	ENTER($ALCH,FILE,ALEOF);
	WHILE ALEOF 
	     DO	BEGIN
		PRINT(" enter failed ");
		FILE←FRCVER(FILE);
		ENTER($ALCH,FILE,ALEOF);
		END;
 	IF IND>0 
 	   THEN BEGIN
 		$CHNFL[IND,0]←0;			! file existent closed;
 		$CHNFL[IND,1]←$ALCH;
 		END
 	   ELSE BEGIN
		$TOTFL←$TOTFL+1;			! one new file;
	IF $TOTFL>10 THEN ERROR("Ten AL files open, cant open any more");
		$NAMEFL[$TOTFL]←FILE;			! name;
		$CHNFL[$TOTFL,1]←$ALCH;			! channel number;
	 	$CHNFL[$TOTFL,0]←0;			! file open;
 		END;
	IF ¬$NOEXIST THEN BEGIN UGETF($ALCH); OUT($ALCH,FF); END;
	OUT($ALCH,"{ FILE BEING WRITTEN BY POINTY : "&DAT_STR&" }"&CRLF);
	$OULST←NULL;					! file status modified;
	END;

INTERNAL PROCEDURE FCLOSE;
	BEGIN
	INTEGER IND;
	FOR IND←1 STEP 1 UNTIL $TOTFL DO
	    BEGIN
	    $CHNFL[IND,0]←1;  				! sets the file closed in table;
	    PRINT("CLOSING ",$NAMEFL[IND],CRLF); ESC_P;
	    RELEASE($CHNFL[IND,1]);			! releases channels;
	    $ALFL←"DECLAR.AL";				! new default file;
	    END;
	IF $OUT
	   THEN BEGIN
		PRINT("CLOSING ",$TTYFL,CRLF);ESC_P;
		RELEASE($TTYCH,0);			! closes the tty save file;
		$OUT←FALSE;				! sets the flag;
		END;
	END;

	! close the file open;

INTERNAL PROCEDURE AL_CLOSE(STRING FILE );
	BEGIN
       	INTEGER IND;
 	IND←ISFILE(FILE);				! address of file in table;
	IF IND=0 THEN ERROR(FILE&" is not open");
 	$CHNFL[IND,0]←1;				! closes the file;
 	RELEASE($CHNFL[IND,1]);
	! looks for an open file: if no file is open DECLAR.AL is proposed;
	$ALFL←"DECLAR.AL";			
	FOR IND←$TOTFL STEP -1 UNTIL 1 DO
		IF NOT $CHNFL[IND,0] THEN $ALFL←$NAMEFL[IND];
	$OULST←NULL;					! file status modified;
	END;


INTERNAL PROCEDURE WRITECODE(STRING FILE;RPTR(SYMBOL) ELEMENT);
	BEGIN
	INTEGER IND;
	! checks if file exists and if it's open, otherwise open it;
	IF (IND←ISFILE(FILE))= 0
	   THEN	OPENFL(FILE)
	   ELSE IF $CHNFL[IND,0]
		   THEN OPENFL(FILE,IND)
		   ELSE $ALCH←$CHNFL[IND,1];		! channel number;
	! updates information for display;
	IF NOT EQU(FILE,$ALFL)
	   THEN BEGIN
		$ALFL←FILE;				! last file used 
		$OULST←NULL;	
		END;
	! output on the file;

	IF ELEMENT=NULL_RECORD
	THEN BEGIN INTEGER I;
		FOR I←#SC,#VT,#RT,#TR,#FR,#MC DO ST_OUT(I);
	     END
	ELSE CASE SYMBOL:TYPE[ELEMENT] OF
	     BEGIN
		[#SC][#VT][#RT][#TR]
			CPRINT($ALCH,EL_OUT(ELEMENT));
		[#FR] FR_OUT(SYMBOL:OBJECT[ELEMENT]);
		[#MC] MC_OUT(ELEMENT);
		[#PR] OUTSTR("can't output procedures yet")
	     END;
	UDATEFILE($ALCH);
	END;
!	dat_str;

PRESET_WITH "Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sept","Oct","Nov","Dec";
STRING ARRAY $MONTH[0:11];

INTERNAL STRING PROCEDURE DAT_STR;
BEGIN
	INTEGER SDATE,SSEC; integer width,digits;
	INTEGER YEAR,MONTH,DATE,HOUR,MINUTE,SECOND;
	STRING  DATE_STRING;

	comment using ACCTIM UUO;

	quick_code;
		calli	'13,'400101;
		hlrzm	'13,SDATE;
		hrrzm	'13,SSEC;
	end;


	DATE←SDATE MOD 31;
	SDATE←SDATE DIV 31;
	MONTH←SDATE MOD 12;
	YEAR←(SDATE DIV 12) + 1964;

	SECOND←SSEC MOD 60;
	SSEC←SSEC DIV 60;
	MINUTE←SSEC MOD 60;
	HOUR←SSEC DIV 60;

	GETFORMAT(WIDTH,DIGITS);
	SETFORMAT(0,0);
	DATE_STRING←CVS(HOUR)&":";
	SETFORMAT(-2,0);
	DATE_STRING←DATE_STRING&CVS(MINUTE)&"  ";
	SETFORMAT(0,0);
	DATE_STRING←DATE_STRING&CVS(DATE+1)&" "&$MONTH[MONTH]&" "&CVS(YEAR);
	SETFORMAT(WIDTH,DIGITS);
	RETURN(DATE_STRING);
END;



END "INPOUT";